Métodos de Predictivos (Clasificación o Aprendizaje-Supervisado)

Índices de Calidad del Modelo y funciones auxiliares

── Attaching packages ─────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────── tidyverse 1.2.1 ──
✔ ggplot2 3.2.0     ✔ purrr   0.3.2
✔ tibble  2.1.3     ✔ dplyr   0.8.3
✔ tidyr   0.8.3     ✔ stringr 1.4.0
✔ readr   1.3.1     ✔ forcats 0.4.0
── Conflicts ────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::lag()    masks stats::lag()

Attaching package: 'glue'
The following object is masked from 'package:dplyr':

    collapse

Attaching package: 'scales'
The following object is masked from 'package:purrr':

    discard
The following object is masked from 'package:readr':

    col_factor
equilibrio.variable.predecir <- function(datos, variable.predecir, ylab = "Cantidad de individuos", 
                                        xlab = "", main = paste("Distribución de la variable",variable.predecir), col = NA) {
  gg_color <- function (n) {
     hues <- seq(15, 375, length = n + 1)
     hcl(h = hues, l = 65, c = 100)[1:n]
  }
  if(missing(variable.predecir) | !(variable.predecir %in% colnames(datos))){
    stop("variable.predecir tiene que ser ingresada y ser un nombre de columna", call. = FALSE )
  }
  if(is.character(datos[,variable.predecir]) | is.factor(datos[,variable.predecir])){
    if(length(col) == 0 || is.na(col)){
      col <- gg_color(length(unique(datos[,variable.predecir])))
    }else{
      col <- rep(col,length(unique(datos[,variable.predecir])))
    }
    ggplot(data = datos, mapping = aes_string(x = variable.predecir, fill = variable.predecir)) +
      geom_bar() +
      scale_fill_manual(values = col, name = variable.predecir) +
      labs(x = xlab, y = ylab, title = main) +
      theme_minimal() +
      theme(legend.position = "bottom")
  }else{
    stop("La variable a predecir tienen que ser de tipo factor o character", call. = FALSE )
  }
}

poder.predictivo.numerica <- function(datos, variable.predecir, variable.comparar, ylab = "", 
                                       xlab = "", main = paste("Densidad de la variable", variable.comparar, 'según', variable.predecir), col = NA){
  gg_color <- function (n) {
     hues <- seq(15, 375, length = n + 1)
     hcl(h = hues, l = 65, c = 100)[1:n]
  }
  if(missing(variable.predecir) | !(variable.predecir %in% colnames(datos))){
    stop("variable.predecir tiene que ser ingresada y ser un nombre de columna", call. = FALSE )
  }
  if(missing(variable.comparar) | !(variable.comparar %in% colnames(datos)) | !is.numeric(datos[,variable.comparar])){
    stop("variable.comparar tiene que ser ingresada y ser un nombre de columna numérica", call. = FALSE )
  }
  
  if(is.character(datos[,variable.predecir]) | is.factor(datos[,variable.predecir])){
    if(length(col) == 0 || is.na(col)){
      col <- gg_color(length(unique(datos[,variable.predecir])))
    }else{
      col <- rep(col,length(unique(datos[,variable.predecir])))
    }
    
    ggplot(data = datos, aes_string(variable.comparar, fill = variable.predecir)) +
      geom_density(alpha = .7, color = NA) +
      scale_fill_manual(values = col) +
      labs(title = main , y = ylab, x = xlab ,fill = variable.predecir) +
      theme_minimal() +
      theme(legend.position = 'bottom',
            legend.title = element_blank(),
            text = element_text(size = 15))
    
  }else{
    stop("La variable a predecir tienen que ser de tipo factor o character", call. = FALSE )
  }
}

poder.predictivo.categorica <- function(datos, variable.predecir, variable.comparar, ylab = "", 
                                        xlab = "", main = paste("Densidad de la variable", variable.comparar, 'según', variable.predecir), col = NA) {
  gg_color <- function (n) {
     hues <- seq(15, 375, length = n + 1)
     hcl(h = hues, l = 65, c = 100)[1:n]
  }
  if(missing(variable.predecir) | !(variable.predecir %in% colnames(datos))){
    stop("variable.predecir tiene que ser ingresada y ser un nombre de columna", call. = FALSE )
  }
  if(missing(variable.comparar) | !(variable.comparar %in% colnames(datos)) | 
     !(is.factor(datos[,variable.comparar]) | is.character(datos[,variable.comparar])) ){
    stop("variable.comparar tiene que ser ingresada y ser un nombre de columna categórica", call. = FALSE )
  }
  
  if(is.character(datos[,variable.predecir]) | is.factor(datos[,variable.predecir])){
    if(length(col) == 0 || is.na(col)){
      col <- gg_color(length(unique(datos[,variable.predecir])))
    }else{
      col <- rep(col,length(unique(datos[,variable.predecir])))
    }
    
    datos2 <- datos %>%
      dplyr::group_by_(variable.comparar, variable.predecir) %>%
      dplyr::summarise(count = n())
    
    if(variable.comparar != variable.predecir){
      datos2 <-   datos2 %>% dplyr::group_by_(variable.comparar)
    }
    datos2 <- datos2 %>% dplyr::mutate(prop = round(count/sum(count),4))
  
    ggplot(data = datos2, mapping = aes_string(x = variable.comparar, y = "prop", fill = variable.predecir)) +
      geom_col(position = "fill") +
      geom_text(aes(label = glue("{percent(prop)} ({count})")), position = position_stack(vjust = .5), color = "white") +
      scale_y_continuous(label = percent) +
      labs(y =  xlab, x  = ylab, title = main) +
      scale_fill_manual(values = col, name = variable.predecir) +
      theme(legend.position = "bottom")+
      coord_flip()
    
  }else{
    stop("La variable a predecir tienen que ser de tipo factor o character", call. = FALSE )
  }
}

# Índices para matrices NxN
indices.general <- function(MC) {
  precision.global <- sum(diag(MC))/sum(MC)
  error.global <- 1 - precision.global
  precision.categoria <- diag(MC)/rowSums(MC)
  res <- list(matriz.confusion = MC, precision.global = precision.global, error.global = error.global, 
              precision.categoria = precision.categoria)
  names(res) <- c("Matriz de Confusión", "Precisión Global", "Error Global", 
                  "Precisión por categoría")
  return(res)
}

El método Árboles de Decisión

Ejemplo Iris

Predicción

$`Matriz de Confusión`
            prediccion
             setosa versicolor virginica
  setosa         13          0         0
  versicolor      0         14         3
  virginica       0          1        19

$`Precisión Global`
[1] 0.92

$`Error Global`
[1] 0.08

$`Precisión por categoría`
    setosa versicolor  virginica 
 1.0000000  0.8235294  0.9500000 


Confusion Matrix:
            prediction
real         setosa versicolor virginica
  setosa         13          0         0
  versicolor      0         14         3
  virginica       0          1        19

Overall Accuracy: 0.9200
Overall Error:    0.0800

Category Accuracy:

       setosa   versicolor    virginica
     1.000000     0.823529     0.950000

$`Matriz de Confusión`
            prediccion
             setosa versicolor virginica
  setosa         13          0         0
  versicolor      0         14         3
  virginica       0          1        19

$`Precisión Global`
[1] 0.92

$`Error Global`
[1] 0.08

$`Precisión por categoría`
    setosa versicolor  virginica 
 1.0000000  0.8235294  0.9500000 


Confusion Matrix:
            prediction
real         setosa versicolor virginica
  setosa         13          0         0
  versicolor      0         14         3
  virginica       0          1        19

Overall Accuracy: 0.9200
Overall Error:    0.0800

Category Accuracy:

       setosa   versicolor    virginica
     1.000000     0.823529     0.950000

Predicción con selección de variables


Attaching package: 'kknn'
The following objects are masked from 'package:trainR':

    contr.dummy, contr.ordinal

$`Matriz de Confusión`
            prediccion
             setosa versicolor virginica
  setosa         19          0         0
  versicolor      0         16         0
  virginica       0          2        13

$`Precisión Global`
[1] 0.96

$`Error Global`
[1] 0.04

$`Precisión por categoría`
    setosa versicolor  virginica 
 1.0000000  1.0000000  0.8666667 


Confusion Matrix:
            prediction
real         setosa versicolor virginica
  setosa         19          0         0
  versicolor      0         16         0
  virginica       0          2        13

Overall Accuracy: 0.9600
Overall Error:    0.0400

Category Accuracy:

       setosa   versicolor    virginica
     1.000000     1.000000     0.866667

Ejemplo Scoring

Predicción

'data.frame':   5000 obs. of  6 variables:
 $ MontoCredito     : int  14327 111404 21128 15426 10351 27060 243369 16300 18319 107037 ...
 $ IngresoNeto      : Ord.factor w/ 2 levels "1"<"2": 1 1 1 2 1 1 1 2 2 2 ...
 $ CoefCreditoAvaluo: Ord.factor w/ 12 levels "1"<"2"<"3"<"4"<..: 1 1 1 1 1 1 1 1 1 1 ...
 $ MontoCuota       : Factor w/ 4 levels "Alto","Bajo",..: 4 4 4 4 4 4 4 4 4 4 ...
 $ GradoAcademico   : Factor w/ 2 levels "Bachiller","Licenciatura": 1 1 1 1 1 1 1 1 1 1 ...
 $ BuenPagador      : Factor w/ 2 levels "No","Si": 2 2 2 2 2 2 2 2 2 2 ...

$`Matriz de Confusión`
    prediccion
      No  Si
  No  67  34
  Si  14 635

$`Precisión Global`
[1] 0.936

$`Error Global`
[1] 0.064

$`Precisión por categoría`
       No        Si 
0.6633663 0.9784284 


Confusion Matrix:
    prediction
real  No  Si
  No  67  34
  Si  14 635

Overall Accuracy: 0.9360
Overall Error:    0.0640

Category Accuracy:

           No           Si
     0.663366     0.978428

Selección de Variables

'data.frame':   5000 obs. of  6 variables:
 $ MontoCredito     : int  14327 111404 21128 15426 10351 27060 243369 16300 18319 107037 ...
 $ IngresoNeto      : Ord.factor w/ 2 levels "1"<"2": 1 1 1 2 1 1 1 2 2 2 ...
 $ CoefCreditoAvaluo: Ord.factor w/ 12 levels "1"<"2"<"3"<"4"<..: 1 1 1 1 1 1 1 1 1 1 ...
 $ MontoCuota       : Factor w/ 4 levels "Alto","Bajo",..: 4 4 4 4 4 4 4 4 4 4 ...
 $ GradoAcademico   : Factor w/ 2 levels "Bachiller","Licenciatura": 1 1 1 1 1 1 1 1 1 1 ...
 $ BuenPagador      : Factor w/ 2 levels "No","Si": 2 2 2 2 2 2 2 2 2 2 ...

Predicción con selección de variables

'data.frame':   5000 obs. of  6 variables:
 $ MontoCredito     : int  14327 111404 21128 15426 10351 27060 243369 16300 18319 107037 ...
 $ IngresoNeto      : Ord.factor w/ 2 levels "1"<"2": 1 1 1 2 1 1 1 2 2 2 ...
 $ CoefCreditoAvaluo: Ord.factor w/ 12 levels "1"<"2"<"3"<"4"<..: 1 1 1 1 1 1 1 1 1 1 ...
 $ MontoCuota       : Factor w/ 4 levels "Alto","Bajo",..: 4 4 4 4 4 4 4 4 4 4 ...
 $ GradoAcademico   : Factor w/ 2 levels "Bachiller","Licenciatura": 1 1 1 1 1 1 1 1 1 1 ...
 $ BuenPagador      : Factor w/ 2 levels "No","Si": 2 2 2 2 2 2 2 2 2 2 ...

$`Matriz de Confusión`
    prediccion
      No  Si
  No  57  48
  Si   6 639

$`Precisión Global`
[1] 0.928

$`Error Global`
[1] 0.072

$`Precisión por categoría`
       No        Si 
0.5428571 0.9906977 


Confusion Matrix:
    prediction
real  No  Si
  No  57  48
  Si   6 639

Overall Accuracy: 0.9280
Overall Error:    0.0720

Category Accuracy:

           No           Si
     0.542857     0.990698